home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-10-06 | 6.8 KB | 279 lines | [TEXT/MPS ] |
- {************************************************************************************
- *
- * Project Name: CMTools
- * File Name: cscr.p
- * Authors: Rob Neville, Alex Kazim, Carol Lee, Byron Han
- * Date: May 17, 1989
- *
- * Description:
- *
- *************************************************************************************
- *
- * Revision History:
- * 5/17/89 - Original version by Rob Neville (IIx)
- * 6/26/89 - Rev'd for b2 of Comm Toolbox
- *
- ************************************************************************************}
-
- UNIT mycscr;
-
- INTERFACE
-
- USES
- MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf,
- FixMath, Script,
- CMIntf,
- ConnectionTool,
- CMTool,
- CMUtil,
- CRMIntf,
- CTBUtils;
-
- CONST
- MAX_RSRC_LEN = 256;
-
- function cscr(hConn: ConnHandle; msg: integer;p1,p2,p3: longint): longint;
-
- IMPLEMENTATION
-
-
- function SetConfig(hConn: ConnHandle; theStr:Ptr;StrResID: integer): INTEGER; FORWARD;
- function GetConfigStr(hConn: ConnHandle; StrResID: integer): Ptr; FORWARD;
-
-
- { ************************** }
- { Entry for Script Interface }
- { ************************** }
-
- function cscr(hConn: ConnHandle;msg: integer;p1,p2,p3: longint): longint;
- VAR
- saved : SignedByte;
-
- begin
- saved := HGetState( handle(hConn) );
- hLock(handle(hConn));
- case msg of
- cmMgetMsg:
- cscr := ord(GetConfigStr( hConn, verUS));
- cmMsetMsg:
- cscr := SetConfig( hConn, Ptr(p1), verUS);
- end; {case}
- HSetState(handle(hConn), saved);
- end; {fscr}
-
-
- { ************************************************** }
- { Takes a piece of a configuration string, parses it, }
- { and sets the configuration data }
- { ************************************************** }
- { returns 0 if no error, -1 for generic errors and }
- { string index ( would be 1 base ) if the token wasn't recognized }
-
- function SetConfig( hConn: ConnHandle; theStr:Ptr;StrResID: integer): INTEGER;
- var
- pConfig : ConfigPtr;
- i, local : integer;
- myToken : TokenRecPtr; {each token}
- theVal : longint;
- aTokenPtr : TokenBlockPtr; {the whole token block}
- returnVal : longint;
- tempVal,
- tokeIndex, {string index for token strings}
- valIndex : integer; {string index for value strings}
- tokeStr : str255; {token as string}
- procID : integer ;
- oldattr : integer ;
- charcount : integer;
- error : integer ;
- theToken : tokenType;
-
- begin
- {Map to local Resource IDs}
- pConfig := ConfigPtr( hConn^^.config );
- procID := hConn^^.procID ;
- StrResID:= CRMLocalToRealID(ClassCM,procID,'STR#',StrResID);
- if StrResID = -1 then
- begin
- SetConfig:= -1;
- EXIT(SetConfig); {abort, abort}
- end;
-
- returnVal:= InitTokenBlock(aTokenPtr) ;
- if returnVal <> noErr then
- begin
- SetConfig:= returnVal;
- EXIT(SetConfig); {abort, abort}
- end;
-
- returnVal := 1;
-
- aTokenPtr^.source := theStr; {what to parse}
- aTokenPtr^.sourceLength := strLen(theStr); {just how long}
-
- {tokenize the string}
- if IntlTokenize(aTokenPtr) <> tokenOK then
- begin
- DisposeTokenBlock(aTokenPtr);
- SetConfig:= -1;
- EXIT(SetConfig);
- end;
-
- {for every token}
- for i := 0 to (aTokenPtr^.tokenCount -1) do
- begin
- theToken := GetSuperToken(aTokenPtr,i,tokeStr);
- if theToken in WhiteTokens then
- cycle
- else if theToken = TokenAlpha then
- begin
- returnVal := 1;
-
- tokeIndex := MatchResString(tokeStr,1,NUMOFSTRING,StrResID);
- if tokeIndex = -1 then
- leave;
- if not (GetSuperToken(aTokenPtr,i,tokeStr) in WhiteTokens) then
- leave;
- case tokeIndex of
-
- BYRON_ID:
- if GetSuperToken(aTokenPtr,i,tokeStr) = tokenAlpha then
- begin
- valIndex := MatchResString(tokeStr,TRUE_ID,FALSE_ID,StrResID);
- if valIndex <> -1 then
- begin
- returnVal := 0;
- if valIndex = FALSE_ID then
- pConfig^.param1 := FALSE
- else if valIndex = TRUE_ID then
- pConfig^.param1 := TRUE
- else
- returnVal := 1;
- end;
- end;{ BYRON_ID}
-
- ROB_ID:
- if GetSuperToken(aTokenPtr,i,tokeStr) = tokenAlpha then
- begin
- valIndex := MatchResString(tokeStr,TRUE_ID,FALSE_ID,StrResID);
- if valIndex <> -1 then
- begin
- returnVal := 0;
- if valIndex = FALSE_ID then
- pConfig^.param2 := FALSE
- else if valIndex = TRUE_ID then
- pConfig^.param2 := TRUE
- else
- returnVal := 1;
- end;
- end; { ROB_ID }
-
- end; {case}
- if returnVal = 1 then
- leave ;
- end {An Alpha Token}
- else
- leave ; { abort on error }
- end; {for every token}
- if returnVal = 1 then
- begin
- { get the first character position for the unrecognized token }
- i := i - 1;
- returnVal := 0 ;
- for charcount := 1 TO i DO
- begin
- myToken := TokenRecPtr(ord(aTokenPtr^.tokenList) + (charcount-1)*sizeOf(TokenRec));
- returnVal := returnVal + myToken^.length;
- end ;
- returnVal := returnVal + 1 ; { because the string index is 1 base }
- end;
-
- DisposeTokenBlock(aTokenPtr);
- SetConfig:= returnVal; {g'day, mate}
- end; {SetConfig}
-
-
-
- { ************************************************************* }
- { Reads thru the configuration data and returns a null- termiated }
- { config string, returns zero if error occurs }
- { ************************************************************* }
-
- function GetConfigStr(hConn: ConnHandle; StrResID: integer): Ptr;
- var
- configStr : Ptr; {string to return}
- tempPtr : Ptr;
- pConfig : ConfigPtr;
- theString : Str255;
- i : integer;
- anyErr : integer;
- valIndex : integer;
- procID : integer;
- totalLen : longint;
- notDone : Boolean;
- firstPass : Boolean;
- configHdl : Handle;
- savedConfigStr : Ptr;
-
- begin
- procID := hConn^^.procID ;
- pConfig := ConfigPtr(hConn^^.config);
- notDone := TRUE;
- firstPass := TRUE;
-
- StrResID:= CRMLocalToRealID(ClassCM,procID,'STR#',StrResID);
- if StrResID = -1 then
- begin
- GetConfigStr := Ptr(-1 );
- EXIT(GetConfigStr);
- end ;
- while notDone do
- begin
- totalLen := 0;
- for i := 1 to NUMOFSTRING do
- begin
- GetIndString(theString,StrResID,i);
- if theString[0] = chr(0) then
- leave;
- totalLen := totalLen + MyCat(configStr,theString,firstPass);
- case i of
- BYRON_ID:
- begin
- if pConfig^.param1 = TRUE then
- GetIndString(theString,StrResID,TRUE_ID)
- else
- GetIndString(theString,StrResID,FALSE_ID);
- totalLen := totalLen + MyCat(configStr,theString,firstPass);
- end;
- ROB_ID:
- begin
- if pConfig^.param2 = TRUE then
- GetIndString(theString,StrResID,TRUE_ID)
- else
- GetIndString(theString,StrResID,FALSE_ID);
- totalLen := totalLen + MyCat(configStr,theString,firstPass);
- end;
- end; {case}
- end; {for}
- if firstPass then
- begin
- firstPass := false;
- configStr := NewPtr (totalLen);
- if configStr = NIL then
- begin
- GetConfigStr := nil;
- EXIT(GetConfigStr);
- end;
- savedconfigStr := configStr;
- end
- else
- begin
- notDone := false;
- end;
- end; {while notdone}
-
- configStr := Ptr(ord4(configStr)-1);
- configStr^ := 0;
- GetConfigStr := savedconfigStr;
- end; {GetConfigStr}
-
- END.